﻿
Imports System.Threading

Public Module spinwait
    Private ReadOnly defaultTimesliceLengthTicks As Int64 = millisecondsToTicks(16)
    Public ReadOnly singleCpu As Boolean = False
    Public ReadOnly timesliceLengthTicks As Int64 = 0
    Public ReadOnly timesliceLengthMs As Int64 = 0
    Public ReadOnly halfTimesliceLengthTicks As Int64 = 0
    Public ReadOnly halfTimesliceLengthMs As Int64 = 0
    Public ReadOnly quarterTimesliceLengthTicks As Int64 = 0
    Public ReadOnly quarterTimesliceLengthMs As Int64 = 0
    Public ReadOnly eighthTimesliceLengthTicks As Int64 = 0
    Public ReadOnly eighthTimesliceLengthMs As Int64 = 0
    Public ReadOnly sixteenthTimesliceLengthTicks As Int64 = 0
    Public ReadOnly sixteenthTimesliceLengthMs As Int64 = 0
    Public ReadOnly twoTimesliceLengthTicks As Int64 = 0
    Public ReadOnly twoTimesliceLengthMs As Int64 = 0
    Public ReadOnly fourTimesliceLengthTicks As Int64 = 0
    Public ReadOnly fourTimesliceLengthMs As Int64 = 0
    Public ReadOnly eightTimesliceLengthTicks As Int64 = 0
    Public ReadOnly eightTimesliceLengthMs As Int64 = 0
    Public ReadOnly sixteenTimesliceLengthTicks As Int64 = 0
    Public ReadOnly sixteenTimesliceLengthMs As Int64 = 0
    Public ReadOnly suggestTryWaitLengthMs As Int64 = 0
    Public ReadOnly loopsPerMs As Int64 = 0
    Public ReadOnly loopsPerYield As Int64 = 0

    Private Function toMs(ByVal ticks As Int64) As Int64
        Return max(ticksToMilliseconds(ticks), 1)
    End Function

    Private Function sl(ByVal bits As Byte) As Int64
        assert(timesliceLengthTicks <> 0)
        Return timesliceLengthTicks << bits
    End Function

    Private Function sr(ByVal bits As Byte) As Int64
        assert(timesliceLengthTicks <> 0)
        Return max(timesliceLengthTicks >> bits, 1)
    End Function

    Private Function decideTimesliceLengthTicks_sleepTicks(ByVal thisRound As Int64) As Int64
        Return thisRound * 15 / 16
    End Function

    Private Function decideTimesliceLengthTicks() As Int64
        Dim timesliceLengthTicks As Int64 = 0

        Dim startticks As Int64 = 0
        Dim thisround As Int64 = 0
        startticks = Now.hires_ticks()
        sleepTicks(decideTimesliceLengthTicks_sleepTicks(defaultTimesliceLengthTicks))
        thisround = Now.hires_ticks() - startticks
        timesliceLengthTicks += thisround
        For i As Int32 = 0 To 6
            startticks = Now.hires_ticks()
            sleepTicks(decideTimesliceLengthTicks_sleepTicks(thisround))
            thisround = (Now.hires_ticks() - startticks + thisround) >> 1
            timesliceLengthTicks += thisround
        Next
        timesliceLengthTicks >>= 3
        If timesliceLengthTicks <= millisecondsToTicks(1) Then
            timesliceLengthTicks = defaultTimesliceLengthTicks
            raiseError(errorHandle.errorType.system,
                       "cannot determined length of timeslice, use default value as ",
                       ticksToMilliseconds(defaultTimesliceLengthTicks), "ms.")
        End If

        Return timesliceLengthTicks
    End Function

    Private Function decideLoopsPerMs() As Int64
        Dim loopend As Int32 = Convert.ToInt32(maxInt16) << 12
        Dim startMs As Int64 = 0
        startMs = ticksToMilliseconds(Now.hires_ticks())
        For i As Int32 = 0 To loopend
        Next
        Return loopend / (ticksToMilliseconds(Now.hires_ticks()) - startMs)
    End Function

    Private Function decideLoopsPerYield() As Int64
        Return ifoper((loopsPerMs >> 8) <= 0, 4096, (loopsPerMs >> 8))
    End Function

    Sub New()
        now_t.global.environmentMilliseconds()
        singleCpu = (Environment.ProcessorCount = 1)

        timesliceLengthTicks = decideTimesliceLengthTicks()
        halfTimesliceLengthTicks = sr(1)
        quarterTimesliceLengthTicks = sr(2)
        eighthTimesliceLengthTicks = sr(3)
        sixteenthTimesliceLengthTicks = sr(4)
        twoTimesliceLengthTicks = sl(1)
        fourTimesliceLengthTicks = sl(2)
        eightTimesliceLengthTicks = sl(3)
        sixteenTimesliceLengthTicks = sl(4)
        halfTimesliceLengthMs = toMs(halfTimesliceLengthTicks)
        quarterTimesliceLengthMs = toMs(quarterTimesliceLengthTicks)
        eighthTimesliceLengthMs = toMs(eighthTimesliceLengthTicks)
        sixteenthTimesliceLengthMs = toMs(sixteenthTimesliceLengthTicks)
        twoTimesliceLengthMs = toMs(twoTimesliceLengthTicks)
        fourTimesliceLengthMs = toMs(fourTimesliceLengthTicks)
        eightTimesliceLengthMs = toMs(eightTimesliceLengthTicks)
        sixteenTimesliceLengthMs = toMs(sixteenTimesliceLengthTicks)
        If singleCpu Then
            suggestTryWaitLengthMs = 0
        Else
            suggestTryWaitLengthMs = sixteenthTimesliceLengthMs
        End If
        loopsPerMs = decideLoopsPerMs()
        loopsPerYield = decideLoopsPerYield()

        Console.Error.WriteLine(strcat("determined singleCpu = ", singleCpu,
                                       ", timeslice length in ticks = ", timesliceLengthTicks,
                                       ", loopsPerMs = ", loopsPerMs,
                                       ", loopsPerYield = ", loopsPerYield))
    End Sub

    Private Function should_yield() As Boolean
        Return singleCpu
    End Function

    Public Function not_force_yield() As Boolean
        Return yield(False)
    End Function

    Public Function force_yield() As Boolean
        Return yield(True)
    End Function

    Public Function yield(Optional ByVal force As Boolean = True) As Boolean
        If force OrElse should_yield() Then
            Dim startMs As Int64 = 0
            startMs = now_t.global.environmentMilliseconds()
            sleep(0)
            Return (now_t.global.environmentMilliseconds() - startMs) >= eighthTimesliceLengthMs
        Else
            Return False
        End If
    End Function

    Public Function try_wait_when(ByVal d As _do(Of Boolean),
                                  Optional ByVal ms As Int64 = npos,
                                  Optional ByRef waitRounds As Int64 = 0,
                                  Optional ByRef yieldTimes As Int64 = 0) As Boolean
        If d Is Nothing Then
            Return False
        Else
            If ms < 0 Then
                ms = suggestTryWaitLengthMs
            End If
            waitRounds = 0
            yieldTimes = 0
            Dim startMs As Int64 = 0
            startMs = now_t.global.environmentMilliseconds()
            Dim rtn As Boolean = False
            rtn = d()
            While (now_t.global.environmentMilliseconds() - startMs) < ms AndAlso rtn
                If not_force_yield() Then
                    safe_increase(yieldTimes)
                End If
                safe_increase(waitRounds)
                rtn = d()
            End While

            Return rtn
        End If
    End Function

    Public Function try_wait_until(ByVal d As _do(Of Boolean),
                                   Optional ByVal ms As Int64 = npos,
                                   Optional ByRef waitRounds As Int64 = 0,
                                   Optional ByRef yieldTimes As Int64 = 0) As Boolean
        Return Not try_wait_when(reverse(d), ms, waitRounds, yieldTimes)
    End Function

    Public Sub strict_wait_when(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)
        If singleCpu Then
            lazy_wait_when(d, o)
        ElseIf Not d Is Nothing Then
            While d(o)
            End While
        End If
    End Sub

    Public Sub wait_when(Of T)(ByVal d As _do(Of T, Boolean), ByVal loops_per_yield As UInt64, ByRef o As T)
        assert(loops_per_yield >= 1)
        If singleCpu Then
            lazy_wait_when(d, o)
        Else
            Dim loops_per_yield_m_1 As UInt64 = 0
            loops_per_yield_m_1 = loops_per_yield - 1
            Dim i As UInt64 = 0
            While d(o)
                i += 1
                If i = loops_per_yield Then
                    If force_yield() Then
                        i = 0
                    Else
                        i = loops_per_yield_m_1
                    End If
                ElseIf not_force_yield() Then
                    i = 0
                End If
            End While
        End If
    End Sub

    Public Sub wait_when(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)
        wait_when(d, loopsPerYield, o)
    End Sub

    Public Sub lazy_wait_when(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)
        If Not d Is Nothing Then
            While d(o)
                force_yield()
            End While
        End If
    End Sub

    Private Delegate Sub wait_when_delegate(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)

    Private Sub wait_when(ByVal d As _do(Of Boolean), ByVal w As wait_when_delegate(Of Byte))
        assert(Not w Is Nothing)
        If Not d Is Nothing Then
            w(Function(ByRef i As Byte) As Boolean
                  Return d()
              End Function,
              0)
        End If
    End Sub

    Public Sub strict_wait_when(ByVal d As _do(Of Boolean))
        wait_when(d, AddressOf strict_wait_when)
    End Sub

    Public Sub wait_when(ByVal d As _do(Of Boolean))
        wait_when(d, AddressOf wait_when)
    End Sub

    Public Sub lazy_wait_when(ByVal d As _do(Of Boolean))
        wait_when(d, AddressOf lazy_wait_when)
    End Sub

    Private Sub wait_until(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T,
                                 ByVal w As wait_when_delegate(Of T))
        assert(Not w Is Nothing)
        If Not d Is Nothing Then
            w(Function(ByRef i As T) As Boolean
                  Return Not d(i)
              End Function,
              o)
        End If
    End Sub

    Public Sub strict_wait_until(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)
        wait_until(d, o, AddressOf strict_wait_when)
    End Sub

    Public Sub wait_until(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)
        wait_until(d, o, AddressOf wait_when)
    End Sub

    Public Sub wait_until(Of T)(ByVal d As _do(Of T, Boolean), ByVal loops_per_yield As UInt64, ByRef o As T)
        wait_until(d, o, Sub(x, ByRef y)
                             wait_when(x, loops_per_yield, y)
                         End Sub)
    End Sub

    Public Sub lazy_wait_until(Of T)(ByVal d As _do(Of T, Boolean), ByRef o As T)
        wait_until(d, o, AddressOf lazy_wait_when)
    End Sub

    Private Sub wait_until(ByVal d As _do(Of Boolean), ByVal w As wait_when_delegate(Of Byte))
        assert(Not w Is Nothing)
        If Not d Is Nothing Then
            w(Function(ByRef i As Byte) As Boolean
                  Return d()
              End Function,
              0)
        End If
    End Sub

    Public Sub strict_wait_until(ByVal d As _do(Of Boolean))
        wait_until(d, AddressOf strict_wait_until)
    End Sub

    Public Sub wait_until(ByVal d As _do(Of Boolean))
        wait_until(d, AddressOf wait_until)
    End Sub

    Public Sub lazy_wait_until(ByVal d As _do(Of Boolean))
        wait_until(d, AddressOf lazy_wait_until)
    End Sub

    Public Sub yield_wait(ByVal e As WaitHandle, Optional ByVal waitMs As Int32 = 1)
        If e Is Nothing Then
            not_force_yield()
        Else
            assert(Timeout.Infinite < 0)
            If waitMs < Timeout.Infinite Then
                waitMs = Timeout.Infinite
            End If
            If Not e.WaitOne(0) Then
                not_force_yield()
                e.WaitOne(waitMs)
            End If
        End If
    End Sub
End Module
